Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/winsweep/winsweep.frm

Visual Basic Form | 1995-05-08 | 9.9 KB | 352 lines

VERSION 2.00
Begin Form Form1
   AutoRedraw      =   -1  'True
   BackColor       =   &H00C0FFC0&
   Caption         =   "WinSweep 1.3 - (c)1991 Nils Segerdahl"
   ClientHeight    =   4815
   ClientLeft      =   240
   ClientTop       =   1395
   ClientWidth     =   8760
   Height          =   5220
   Icon            =   WINSWEEP.FRX:0000
   Left            =   180
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4815
   ScaleWidth      =   8760
   Top             =   1050
   Width           =   8880
   Begin FileListBox File1
      BackColor       =   &H00C0C0C0&
      Height          =   2370
      Hidden          =   -1  'True
      Left            =   7080
      System          =   -1  'True
      TabIndex        =   0
      Top             =   2280
      Width           =   1575
   End
   Begin DirListBox Dir1
      BackColor       =   &H00C0C0C0&
      Height          =   1575
      Left            =   7080
      TabIndex        =   2
      Top             =   600
      Width           =   1575
   End
   Begin TextBox Text1
      BackColor       =   &H00FFFFFF&
      ForeColor       =   &H00000000&
      Height          =   4095
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   1
      Text            =   " "
      Top             =   600
      Width           =   6855
   End
   Begin DriveListBox Drive1
      BackColor       =   &H00C0C0C0&
      Height          =   315
      Left            =   7320
      TabIndex        =   3
      Top             =   120
      Width           =   1335
   End
   Begin CommandButton Command6
      Caption         =   "&?"
      Height          =   375
      Left            =   6720
      TabIndex        =   10
      TabStop         =   0   'False
      Top             =   120
      Width           =   375
   End
   Begin CommandButton Command2
      Caption         =   "&Quit"
      Height          =   375
      Left            =   6000
      TabIndex        =   9
      TabStop         =   0   'False
      Top             =   120
      Width           =   615
   End
   Begin CommandButton Command5
      Caption         =   "&Run"
      Height          =   375
      Left            =   5400
      TabIndex        =   7
      TabStop         =   0   'False
      Top             =   120
      Width           =   495
   End
   Begin CommandButton Command4
      Caption         =   "&Copy"
      Height          =   375
      Left            =   4680
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   120
      Width           =   615
   End
   Begin CommandButton Command3
      Caption         =   "&Delete"
      Height          =   375
      Left            =   3840
      TabIndex        =   5
      TabStop         =   0   'False
      Top             =   120
      Width           =   735
   End
   Begin CommandButton Command1
      Caption         =   "&Save"
      Height          =   375
      Left            =   3000
      TabIndex        =   4
      TabStop         =   0   'False
      Top             =   120
      Width           =   735
   End
   Begin TextBox Text2
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   600
      TabIndex        =   8
      TabStop         =   0   'False
      Text            =   " "
      Top             =   120
      Width           =   2295
   End
   Begin PictureBox Picture1
      BackColor       =   &H00C0FFC0&
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   0
      Picture         =   WINSWEEP.FRX:0302
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   11
      TabStop         =   0   'False
      Top             =   0
      Width           =   495
   End
Sub Command1_Click ()
    saveindex = file1.listindex
    If file1.filename = "" Then
    MsgBox "No file selected"
    Exit Sub
    End If
    If (filesize > FILMAX) Then
    MsgBox "File wold be truncated!"
    Exit Sub
    End If
    tmp$ = "Save file " + file1.filename + " ? "
    rep = MsgBox(tmp$, 36, "SAVE File")
    If rep = 6 Then
    tmp$ = file1.filename
    dotpos = InStr(1, tmp$, ".")
    tmp$ = Left$(tmp$, dotpos)
    On Error GoTo errhand
    Kill tmp$ + "bak"
    On Error GoTo 0
    Name file1.filename As tmp$ + "bak"
    Open file1.filename For Binary As #1
    textstr$ = text1.text
    Put #1, , textstr$
    Close #1
    End If
    file1.Refresh
    file1.listindex = saveindex
    file1.SetFocus
    Exit Sub
errhand:
    Resume Next
End Sub
Sub Command2_Click ()
    tmp$ = "If you like this program, please send" + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + "some money (eg. 25$) to me:" + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + " " + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + "Nils Segerdahl" + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + "Pr
rdsgatan 19B" + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + "S-752 30 Upsala, SWEDEN" + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + " " + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + " " + Chr$(13) + Chr$(10)
    tmp$ = tmp$ + "TERMINATE?" + Chr$(13) + Chr$(10)
    resp% = MsgBox(tmp$, 20, "QUIT")
    If resp% = 6 Then
       End
    End If
End Sub
Sub Command3_Click ()
    saveindex = file1.listindex
    If file1.filename = "" Then
    MsgBox "No file selected"
    Exit Sub
    End If
    tmp$ = "Delete file " + file1.filename + " ? "
    rep = MsgBox(tmp$, 36, "Delete File")
    If rep = 6 Then
    Kill file1.filename
    End If
    file1.Refresh
    file1.listindex = saveindex
    file1.SetFocus
End Sub
Sub Command4_Click ()
    saveindex = file1.listindex
    If file1.filename = "" Then
    MsgBox "No file selected"
    Exit Sub
    End If
    tmp$ = "Copy " + file1.filename + " to "
    tmp$ = InputBox$(tmp$, "Copy file", "")
    screen.mousepointer = 11
    If Len(tmp$) > 0 Then
       Open file1.filename For Binary As #1
       On Error GoTo errhand_cmd4
       Kill tmp$
       On Error GoTo 0
       Open tmp$ For Binary As #2
       i = LOF(1)
       text2.text = "Copying...."
       For j = 1 To i Step 512
        tmp$ = Input$(512, #1)
        Put #2, j, tmp$
       Next j
       text2.text = "Done"
       Close
    End If
    file1.Refresh
    file1.listindex = saveindex
    file1.SetFocus
    screen.mousepointer = 0
    Exit Sub
errhand_cmd4:
    Resume Next
End Sub
Sub Command5_Click ()
    saveindex = file1.listindex
    If file1.filename = "" Then
    MsgBox "No file selected"
    Exit Sub
    End If
    tmp$ = Right$(file1.filename, 4)
    If tmp$ = ".exe" Or tmp$ = ".com" Or tmp$ = ".bat" Then
    res = Shell(file1.filename, 1)
    Else
    MsgBox "File not executable"
    End If
    file1.Refresh
    file1.listindex = saveindex
    file1.SetFocus
End Sub
Sub Command6_Click ()
    form2.Show
End Sub
Sub Dir1_Change ()
    screen.mousepointer = 11
    file1.path = dir1.path
    ChDir dir1.path
    On Error GoTo errh
    file1.listindex = 0
    On Error GoTo 0
    file1.SetFocus
    screen.mousepointer = 0
    Exit Sub
errh:
    Resume Next
End Sub
Sub Drive1_Change ()
    screen.mousepointer = 11
    dir1.path = drive1.drive
    ChDrive (drive1.drive)
    file1.listindex = 0
    file1.SetFocus
    screen.mousepointer = 0
End Sub
Sub errhand ()
End Sub
Sub File1_Click ()
    screen.mousepointer = 11
    filesize = 0
    txtstr$ = String$(FILMAX, " ")
    If Right$(file1.filename, 4) = ".exe" Then
    text2.text = ".EXE file - Not viewable"
    Beep
    text1.text = " "
    ElseIf Right$(file1.filename, 4) = ".com" Then
    text2.text = ".COM file - Not viewable"
    Beep
    text1.text = " "
    ElseIf Right$(file1.filename, 4) = ".bmp" Then
    text2.text = ".bmp file - Not viewable"
    Beep
    text1.text = " "
    ElseIf Right$(file1.filename, 4) = ".dll" Then
    text2.text = ".DLL file - Not viewable"
    Beep
    text1.text = " "
    ElseIf Right$(file1.filename, 4) = ".pcx" Then
    text2.text = ".pcx file - Not viewable"
    Beep
    text1.text = " "
    Else
    Open file1.filename For Binary As #1
    filesize = LOF(1)
    Get #1, , txtstr$
    text1.text = txtstr$
    If filesize > FILMAX Then
        text2.text = file1.filename + " TRUNC " + Str$(filesize) + " byte"
    Else
        text2.text = file1.filename + "  " + Str$(filesize) + " byte"
    End If
    Close #1
    End If
    screen.mousepointer = 0
End Sub
Sub File2_Click ()
End Sub
Sub FileIOdemo ()
    Dim ClientName As String * 20
    NL$ = Chr$(13) + Chr$(10)   ' Define newline.
    ' Make a sample random-access file using the Put statement.
    Msg$ = "Enter a name, using whatever form you like." + NL$ + NL$
    Msg$ = Msg$ + "Press 'Enter' with no name to conclude entry."
    Open "FILEIOX.DAT" For Random As #1 Len = Len(ClientName$)
    ClientName$ = InputBox$(Msg$)   ' Get user input.
    Do While ClientName$ <> String$(20, " ")
    Put #1, , ClientName$   ' Write to file.
    ClientName$ = InputBox$(Msg$)   ' Get user input.
    Loop
    ' Read the sample random-access file using the Get statement.
    Max% = Loc(1)
    If Max% = 0 Then    ' Check if records exist.
    Msg$ = "Your file contains no names." + NL$
    Else
    Msg$ = "Your file contains the following names:" + NL$ + NL$
    End If
    For Indx% = 1 To Max%
    Get #1, Indx%, ClientName$  ' Read from file.
    Msg$ = Msg$ + ClientName$ + NL$
    Next Indx%
    Close #1    ' Close file.
    Msg$ = Msg$ + NL$ + "Choose OK to remove the created test file."
    MsgBox Msg$ ' Display message.
    Kill "FILEIOX.DAT"  ' Remove file from disk.
End Sub
Sub Form_Load ()
    If file1.listcount > -1 Then
       file1.listindex = 0
    End If
End Sub
Sub main ()
    file1.listindex = 0
    file1.SetFocus
End Sub
Sub Picture1_Click ()
    MsgBox "WinSweep by Nils Segerdahl"
End Sub